﻿<%
'''底层HTTP类,用于HTML实时静态化,使用Sa来统筹
Class Ashapo_Http_Class
	'远程地址,请求方式,指定编码,是否异步,用户名,密码
	Public Url, Method, CharSet, Async, User, Password
	'原始代码,远程文件二进制流数据
	Private s_html, s_body, s_data
	'解析超时时间,连接超时时间,发送数据超时时间,接受数据超时时间
	Public ResolveTimeout, ConnectTimeout, SendTimeout, ReceiveTimeout
	
	'''构造
	Private Sub Class_Initialize()
		CharSet = "UTF-8"
		Async = False
		User = ""
		Password = ""
		s_url = ""
		s_html = ""
		s_data = ""
		s_body = Empty
		ResolveTimeout = 20000
		ConnectTimeout = 20000
		SendTimeout = 300000
		ReceiveTimeout = 60000
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
	End Sub

	'''二进制流转字符串
	'p_s:二进制流
	'p_c:编码
	Private Function bytes2Bstr_(Byval p_s, Byval p_c) 
		Dim t_s
		Set t_s = Server.CreateObject("Adodb.Stream")
		With t_s
			.Type = 1
			.Mode =3
			.Open
			.Write p_s
			.Position = 0
			.Type = 2
			.Charset = p_c
			bytes2Bstr_ = .ReadText
			.Close
		End With
		Set t_s = Nothing
	End Function

	'''格式化提交的数据
	'p_a:数据(字符串/数组)
	Private Function serialize_(Byval p_a)
		Dim t_t, t_i, t_n, t_v : t_t = ""
		If IsN(p_a) Then
			Exit Function
		End If
		If IsArray(p_a) Then
			For t_i = 0 To Ubound(p_a)
				t_n = CLeft(p_a(t_i),":")
				t_v = CRight(p_a(t_i),":")
				t_t = t_t & "&" & t_n & "=" & Server.URLEncode(t_v)
			Next
			If Len(t_t) > 1 Then
				t_t = Mid(t_t,2)
			End If
			serialize_ = t_t
		Else
			serialize_ = p_a
		End If
	End Function

	'''设置HTTP对象
	Private Function httpObj_()
		If IsInstall("MSXML2.serverXMLHTTP") Then
			Set httpObj_ = Server.CreateObject("MSXML2.serverXMLHTTP")
			'Response.Write("MSXML2.serverXMLHTTP")
			'Response.Flush
		ElseIf IsInstall("MSXML2.XMLHTTP") Then
			Set httpObj_ = Server.CreateObject("MSXML2.XMLHTTP")
			'Response.Write("MSXML2.XMLHTTP")
			'Response.Flush
		ElseIf IsInstall("Microsoft.XMLHTTP") Then
			Set httpObj_ = Server.CreateObject("Microsoft.XMLHTTP")
			'Response.Write("Microsoft.XMLHTTP")
			'Response.Flush
		Else
			Set httpObj_ = Nothing
			'抛出错误
			Errc.Throw(11)
		End If
		'Response.End()
	End Function
	
	'''格式化链接
	'p_i:本地运行asp文件地址(可含GET参数)
	Private Function formatUrl_(Byval p_i)
		If Lcase(Request.ServerVariables("HTTPS"))="on" Then
			formatUrl_ = "https://"
		Else
			formatUrl_ = "http://" 
		End If
		'If C_WebDname = "" Then
			formatUrl_ = formatUrl_ & Request.ServerVariables("Http_Host") & p_i
		'Else
		'	formatUrl_ = C_WebDname & p_i
		'End If
	End Function
	
	'''用参数配置的方式获取本地运行文件数据
	'p_i:本地运行asp文件地址
	'p_m:请求方式
	'p_a:是否异步
	'p_d:提交数据
	'p_u:用户名
	'p_p:密码
	Public Function GetData(Byval p_i, Byval p_m, Byval p_a, Byval p_d, Byval p_u, Byval p_p)
		Dim t_o : Set t_o = httpObj_()
		t_o.SetTimeOuts ResolveTimeout, ConnectTimeout, SendTimeout, ReceiveTimeout
		p_i = formatUrl_(p_i)
		'Response.Write(p_i)
		'Response.Flush
		'Response.End()
		s_url = p_i
		p_m = IIF(Has(p_m),UCase(p_m),"GET")
		If IsN(p_a) Then
			p_a = False
		End If
		If Has(p_u) Then
			t_o.Open p_m, p_i, p_a, p_u, p_p
		Else
			t_o.Open p_m, p_i, p_a
		End If
		If p_m = "POST" Then
			t_o.Send serialize_(p_d)
		Else
			t_o.Send
		End If
		If t_o.ReadyState <> 4 Then
			GetData = "发生错误:服务器发生错误!"
			'出错
			Errc.Raise(111)
		ElseIf t_o.Status = 200 Then
			s_body = t_o.ResponseBody
			GetData = bytes2Bstr_(s_body, CharSet)
		Else
			GetData = "发生错误:" & t_o.Status & " " & t_o.StatusText
			'出错
			Errc.Raise(111)
		End If
		Set t_o = Nothing
		s_html = GetData
		'Response.Write(s_html)
		'Response.End
	End Function

	'''用属性配置方式获取远程文件数据
	Public Function [Open]()
		[Open] = GetData(Url, Method, Async, s_data, User, Password)
	End Function

	'''用GET方式请求远程文件的数据
	'p_i:远程地址
	Public Function [Get](Byval p_i)
		[Get] = GetData(p_i, "GET", Async, s_data, User, Password)
	End Function

	'''用POST方式请求远程文件的数据
	'p_i:远程地址
	Public Function Post(Byval p_i)
		Post = GetData(p_i, "POST", Async, s_data, User, Password)
	End Function
	
	'''获取已读取的远程文件的原始代码
	Public Property Get Html()
		Html = s_html
	End Property
	
	'''获取当前链接的HTML源码
	'暂时先支持GET模式/POST模式等以后再支持
	Public Property Get [Now]()
		[Now] = ""
	End Property
End Class
%>